home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / IPC / Named Pipes / API / ParentMainFormUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-28  |  2.5 KB  |  99 lines
  1. unit ParentMainFormUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure FormDestroy(Sender: TObject);
  14.   private
  15.     PipeRead: THandle;
  16.   end;
  17.  
  18. {$ifdef Ver90}
  19.   //This exception class did not exist in Delphi 2
  20.   EWin32Error = class(Exception);
  21. {$endif}
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. const
  27.   PipeNameFixedPrefix = '\\.\pipe\';
  28.   PipeName = PipeNameFixedPrefix + 'SampleNamedPipe';
  29.   PipeMaxInstances = 1; //only allow 1 pipe
  30.   PipeOutBufferSize = 0; //any size
  31.   PipeInBufferSize = 0; //any size
  32.   PipeTimeout = 0; //don't wait
  33.  
  34. implementation
  35.  
  36. uses
  37.   ParentNamedPipeUnit;
  38.  
  39. {$R *.DFM}
  40.  
  41. {$ifdef Ver90}
  42. //This function class did not exist in Delphi 2
  43. function Win32Check(RetVal: Bool): Bool;
  44. var
  45.   LastError: DWord;
  46. begin
  47.   Result := RetVal;
  48.   if not RetVal then
  49.   begin
  50.     LastError := GetLastError;
  51.     if LastError <> Error_Success then
  52.       raise EWin32Error.CreateFmt( 'Win32 Error.  Code: %d.'#10'%s',
  53.         [LastError, SysErrorMessage(LastError)])
  54.     else
  55.       raise EWin32Error.Create('A Win32 API function failed')
  56.   end;
  57. end;
  58. {$endif}
  59.  
  60. function LaunchChildApp: THandle;
  61. const
  62.   ChildApp = 'ChildNamedPipe.Exe';
  63. var
  64.   SI: TStartupInfo;
  65.   PI: TProcessInformation;
  66. begin
  67.   GetStartupInfo(SI);
  68.   if not CreateProcess(nil, ChildApp, nil, nil, False,
  69.      0, nil, nil, SI, PI) then
  70.     raise EWin32Error.Create('Unable to launch ' + ChildApp);
  71.   Result := PI.HProcess
  72. end;
  73.  
  74. {This will create a named pipe and get a read and write handle
  75. back. The intention is for a child app to write to the pipe and for
  76. this parent app to read from the pipe.}
  77. procedure TForm1.FormCreate(Sender: TObject);
  78. const
  79.   PipeBufferSize = 0; //default size
  80. begin
  81.   PipeRead := CreateNamedPipe(PipeName, Pipe_Access_Inbound, Pipe_Type_Byte,
  82.     PipeMaxInstances, PipeOutBufferSize, PipeInBufferSize, PipeTimeOut, nil);
  83.   if PipeRead = Invalid_Handle_Value then
  84.     raise EWin32Error.Create('Cannot create named pipe');
  85.   //This launches the child process and waits for it to
  86.   //settle down before moving on to the next statement
  87.   WaitForInputIdle(LaunchChildApp, Infinite);
  88.   //Start reader thread off
  89.   with TTestNamedPipe.Create(PipeRead) do
  90.     FreeOnTerminate := True
  91. end;
  92.  
  93. procedure TForm1.FormDestroy(Sender: TObject);
  94. begin
  95.   CloseHandle(PipeRead);
  96. end;
  97.  
  98. end.
  99.